Exploratory Analysis
Overview of outcome of variables
Outcome by county
point <- format_format(big.mark = " ", decimal.mark = ",", scientific = FALSE)
demo_plot = demo %>%
filter(!county_name %in% "Out of state") %>%
group_by(county_name, population) %>%
summarize(total_cases = sum(reported_cases),
total_deaths = sum(reported_deaths),
prevalence = total_cases/mean(population)) %>%
mutate(county_name = fct_reorder(county_name, prevalence)) %>%
ggplot(aes(x = reorder(county_name, prevalence), y = prevalence, color = county_name)) +
geom_point(alpha = 1) +
theme(
legend.position = "none"
) +
labs(x = "County",
y = "Prevalence",
title = "Prevalence Across County") +
theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
scale_y_continuous(labels = point)
ggplotly(demo_plot, width = 800, height = 500)point <- format_format(big.mark = " ", decimal.mark = ",", scientific = FALSE)
demo %>%
filter(!county_name %in% "Out of state") %>%
group_by(county_name, population) %>%
summarize(total_cases = sum(reported_cases),
total_deaths = sum(reported_deaths),
prevalence = total_cases/mean(population)) %>%
mutate(county_name = fct_reorder(county_name, prevalence)) %>%
ggplot(aes(x = prevalence, fill = county_name)) +
geom_histogram(alpha = 0.7) +
labs(x = "Prevalence",
y = "Count") +
theme(
legend.position = "bottom"
) +
theme(legend.title = element_text(size = 5),
legend.key.size = unit(0.3, 'cm'),
legend.text = element_text(size = 4)) +
theme(
axis.title.x = element_text(size = 6),
axis.text.x = element_text(size = 5),
axis.title.y = element_text(size = 6),
axis.text.y = element_text(size = 5)) +
scale_y_continuous(labels = point) +
scale_x_continuous(labels = point)
point <- format_format(big.mark = " ", decimal.mark = ",", scientific = FALSE)
demo_plot_1 = demo %>%
filter(!county_name %in% "Out of state") %>%
group_by(county_name) %>%
summarize(total_cases = sum(reported_cases),
total_deaths = sum(reported_deaths),
death_rate = total_deaths / total_cases) %>%
mutate(county_name = fct_reorder(county_name, death_rate)) %>%
ggplot(aes(x = county_name, y = death_rate, color = county_name)) +
geom_point(alpha = 1) +
theme(
legend.position = "none"
) +
labs(x = "County",
y = "Death Rate",
title = "Death Rate Across County") +
theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
scale_y_continuous(labels = point)
ggplotly(demo_plot_1, width = 800, height = 500)point <- format_format(big.mark = " ", decimal.mark = ",", scientific = FALSE)
demo %>%
filter(!county_name %in% "Out of state") %>%
group_by(county_name, population) %>%
summarize(total_cases = sum(reported_cases),
total_deaths = sum(reported_deaths),
death_rate = total_deaths / total_cases) %>%
mutate(county_name = fct_reorder(county_name, death_rate)) %>%
ggplot(aes(x = death_rate, fill = county_name)) +
geom_histogram(alpha = 0.7) +
labs(x = "Death Rate",
y = "Count") +
theme(
legend.position = "bottom"
) +
theme(legend.title = element_text(size = 5),
legend.key.size = unit(0.3, 'cm'),
legend.text = element_text(size = 4)) +
theme(
axis.title.x = element_text(size = 6),
axis.text.x = element_text(size = 5),
axis.title.y = element_text(size = 6),
axis.text.y = element_text(size = 5)) +
scale_y_continuous(labels = point) +
scale_x_continuous(labels = point)
Worst counties for each COVID outcome
demo_worst_1 =
demo %>%
filter(!county_name %in% "Out of state") %>%
group_by(county_name, population) %>%
summarize(total_cases = sum(reported_cases),
total_deaths = sum(reported_deaths),
prevalence = total_cases/mean(population)) %>%
select(county_name, prevalence) %>%
arrange(desc(prevalence)) %>%
head(10)
demo_worst_2 =
demo %>%
filter(!county_name %in% "Out of state") %>%
group_by(county_name, population) %>%
summarize(total_cases = sum(reported_cases),
total_deaths = sum(reported_deaths),
death_rates = total_deaths/total_cases) %>%
select(county_name, death_rates) %>%
arrange(desc(death_rates)) %>%
head(10)
cbind(demo_worst_1, demo_worst_2) %>%
knitr::kable(digits = 4,
caption = "Worst counties for each COVID outcome",
col.names = c("County for Prevalence", "Prevelence", "County for Death Rate", "Death Rate"))| County for Prevalence | Prevelence | County for Death Rate | Death Rate |
|---|---|---|---|
| Kings | 0.3864 | Siskiyou | 0.0176 |
| Imperial | 0.3483 | Shasta | 0.0168 |
| Lassen | 0.3356 | Sierra | 0.0162 |
| Los Angeles | 0.3249 | Calaveras | 0.0156 |
| San Bernardino | 0.3065 | Tehama | 0.0156 |
| Tuolumne | 0.3034 | Trinity | 0.0147 |
| Riverside | 0.2853 | Imperial | 0.0144 |
| San Diego | 0.2785 | Inyo | 0.0132 |
| Madera | 0.2780 | Tuolumne | 0.0130 |
| Del Norte | 0.2722 | Stanislaus | 0.0128 |
demo_worst_pre_plot =
demo_worst_1 %>%
mutate(county_name = fct_reorder(county_name, prevalence)) %>%
ggplot(aes(x = reorder(county_name, prevalence, decreasing = T), y = prevalence, fill = county_name)) +
geom_bar(stat = "identity", width = 0.5) +
theme(
legend.position = "none"
) +
labs(x = '',
y = "Prevalence",
title = "Worst Prevalence") +
theme(legend.title = element_text(size = 5),
legend.key.size = unit(0.3, 'cm'),
legend.text = element_text(size = 4)) +
theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
theme(
axis.title.x = element_text(size = 6),
axis.text.x = element_text(size = 5),
axis.title.y = element_text(size = 6),
axis.text.y = element_text(size = 5)) +
scale_y_continuous(labels = point)
demo_worst_dea_plot =
demo_worst_2 %>%
mutate(county_name = fct_reorder(county_name, death_rates)) %>%
ggplot(aes(x = reorder(county_name, death_rates, decreasing = T), y = death_rates, fill = county_name)) +
geom_bar(stat = "identity", width = 0.5) +
theme(
legend.position = "none"
) +
labs(x = '',
y = "Death Rate",
title = "Worst Death Rate") +
theme(legend.title = element_text(size = 5),
legend.key.size = unit(0.3, 'cm'),
legend.text = element_text(size = 4)) +
theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
theme(
axis.title.x = element_text(size = 6),
axis.text.x = element_text(size = 5),
axis.title.y = element_text(size = 6),
axis.text.y = element_text(size = 5)) +
scale_y_continuous(labels = point)
demo_worst_pre_plot + demo_worst_dea_plot
Best counties for each COVID outcome
demo_best_1 =
demo %>%
filter(!county_name %in% "Out of state") %>%
group_by(county_name, population) %>%
summarize(total_cases = sum(reported_cases),
total_deaths = sum(reported_deaths),
prevalence = total_cases/mean(population)) %>%
select(county_name, prevalence) %>%
arrange(prevalence) %>%
head(10)
demo_best_2 =
demo %>%
filter(!county_name %in% "Out of state") %>%
group_by(county_name, population) %>%
summarize(total_cases = sum(reported_cases),
total_deaths = sum(reported_deaths),
death_rates = total_deaths/total_cases) %>%
select(county_name, death_rates) %>%
arrange(death_rates) %>%
head(10)
cbind(demo_best_1, demo_best_2) %>%
knitr::kable(digits = 4,
caption = "Best counties for each COVID outcome",
col.names = c("County for Prevalence", "Prevelence", "County for Death Rate", "Death Rate"))| County for Prevalence | Prevelence | County for Death Rate | Death Rate |
|---|---|---|---|
| Modoc | 0.0945 | Alpine | 0.0000 |
| Sierra | 0.0989 | Mono | 0.0025 |
| Trinity | 0.1067 | Plumas | 0.0035 |
| Siskiyou | 0.1225 | Santa Cruz | 0.0042 |
| Alpine | 0.1235 | San Mateo | 0.0043 |
| Humboldt | 0.1667 | Solano | 0.0044 |
| Colusa | 0.1700 | Sonoma | 0.0049 |
| El Dorado | 0.1712 | Napa | 0.0049 |
| Mariposa | 0.1774 | Colusa | 0.0057 |
| Marin | 0.1775 | Alameda | 0.0058 |
demo_best_pre_plot =
demo_best_1 %>%
mutate(county_name = fct_reorder(county_name, prevalence)) %>%
ggplot(aes(x = reorder(county_name, prevalence, decreasing = F), y = prevalence, fill = county_name)) +
geom_bar(stat = "identity", width = 0.5) +
theme(
legend.position = "none"
) +
labs(x = '',
y = "Prevalence",
title = "Best Prevalence") +
theme(legend.title = element_text(size = 5),
legend.key.size = unit(0.3, 'cm'),
legend.text = element_text(size = 4)) +
theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
theme(
axis.title.x = element_text(size = 6),
axis.text.x = element_text(size = 5),
axis.title.y = element_text(size = 6),
axis.text.y = element_text(size = 5)) +
scale_y_continuous(labels = point)
demo_best_dea_plot =
demo_best_2 %>%
mutate(county_name = fct_reorder(county_name, death_rates)) %>%
ggplot(aes(x = reorder(county_name, death_rates, decreasing = F), y = death_rates, fill = county_name)) +
geom_bar(stat = "identity", width = 0.5) +
theme(
legend.position = "none"
) +
labs(x = '',
y = "Death Rate",
title = "Best Death Rate") +
theme(legend.title = element_text(size = 5),
legend.key.size = unit(0.3, 'cm'),
legend.text = element_text(size = 4)) +
theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
theme(
axis.title.x = element_text(size = 6),
axis.text.x = element_text(size = 5),
axis.title.y = element_text(size = 6),
axis.text.y = element_text(size = 5)) +
scale_y_continuous(labels = point)
demo_best_pre_plot + demo_best_dea_plot
Association between outcomes across county
Age vs Total Cases
point <- format_format(big.mark = " ", decimal.mark = ",", scientific = FALSE)
grid.arrange(
age %>%
ggplot(aes(x = age_group, y = total_cases, fill = age_group)) +
geom_bar(stat = "identity", width = 0.5) +
scale_fill_viridis(discrete = TRUE) +
theme(
legend.position = "none"
) +
xlab("Age") +
ylab("Total cases") +
theme(legend.title = element_text(size = 5),
legend.key.size = unit(0.3, 'cm'),
legend.text = element_text(size = 4)) +
theme(
axis.title.x = element_text(size = 6),
axis.text.x = element_text(size = 5),
axis.title.y = element_text(size = 6),
axis.text.y = element_text(size = 5)) +
scale_y_continuous(labels = point),
age %>%
ggplot(aes(x = total_cases, fill = age_group)) +
geom_histogram(aes(y = ..density..), alpha = 0.5, bins = 50) +
geom_density(alpha = 0.3, aes(color = age_group)) +
scale_color_viridis(discrete = TRUE) +
labs(x = "Total cases",
y = "Density") +
theme(legend.position = "right") +
theme(legend.title = element_text(size = 5),
legend.key.size = unit(0.3, 'cm'),
legend.text = element_text(size = 4)) +
theme(
axis.title.x = element_text(size = 6),
axis.text.x = element_text(size = 5),
axis.title.y = element_text(size = 6),
axis.text.y = element_text(size = 5)) +
scale_x_continuous(labels = point) +
scale_y_continuous(labels = point),
age %>%
ggplot(aes(x = age_group, y = total_cases, fill = age_group)) +
geom_boxplot(alpha = 0.5) +
geom_hline(yintercept = median(age$total_cases, na.rm = T), color = "red", size = 0.4, lty = "dashed") +
scale_fill_viridis(discrete = TRUE) +
theme(
legend.position = "none"
) +
xlab("Age") +
ylab("Total cases") +
theme(legend.title = element_text(size = 5),
legend.key.size = unit(0.3, 'cm'),
legend.text = element_text(size = 4)) +
theme(
axis.title.x = element_text(size = 6),
axis.text.x = element_text(size = 5),
axis.title.y = element_text(size = 6),
axis.text.y = element_text(size = 5)) +
scale_y_continuous(labels = point),
layout_matrix = rbind(c(1, 1, 1, 2, 2, 2, 2),
c(1, 1, 1, 2, 2, 2, 2),
c(1, 1, 1, 2, 2, 2, 2),
c(3, 3, 3, 2, 2, 2, 2),
c(3, 3, 3, 2, 2, 2, 2)
))
# Highest Total cases
age_17 =
age %>%
filter(age_group == "0-17") %>%
arrange(date) %>%
mutate(lag = lag(total_cases)) %>%
mutate(growth_perc = (((total_cases - lag) / total_cases)) * 100)
age_49 =
age %>%
filter(age_group == "18-49") %>%
arrange(date) %>%
mutate(lag = lag(total_cases)) %>%
mutate(growth_perc = (((total_cases - lag) / total_cases)) * 100)
age_64 =
age %>%
filter(age_group == "50-64") %>%
arrange(date) %>%
mutate(lag = lag(total_cases)) %>%
mutate(growth_perc = (((total_cases - lag) / total_cases)) * 100)
age_65 =
age %>%
filter(age_group == "65+") %>%
arrange(date) %>%
mutate(lag = lag(total_cases)) %>%
mutate(growth_perc = (((total_cases - lag) / total_cases)) * 100)
age_all =
rbind(age_17, age_49, age_64, age_65) %>%
arrange(desc(growth_perc)) %>%
select(date, age_group, total_cases, growth_perc)
head(age_all) %>%
knitr::kable(
caption = "Highest total cases growth rate by age",
col.names = c("Date", "Age", "Total cases", "Growth rate"),
digits = 2
)| Date | Age | Total cases | Growth rate |
|---|---|---|---|
| 2020-04-29 | 0-17 | 1398 | 9.66 |
| 2020-04-27 | 0-17 | 1190 | 8.82 |
| 2020-04-23 | 0-17 | 936 | 8.65 |
| 2020-05-05 | 0-17 | 1937 | 8.47 |
| 2022-01-09 | 0-17 | 945336 | 8.29 |
| 2022-01-16 | 0-17 | 1158294 | 7.62 |
age_all_low =
rbind(age_17, age_49, age_64, age_65) %>%
arrange(growth_perc) %>%
select(date, age_group, total_cases, growth_perc)
head(age_all_low) %>%
knitr::kable(
caption = "Lowest total cases growth rate by age",
col.names = c("Date", "Age", "Total cases", "Growth rate"),
digits = 2
)| Date | Age | Total cases | Growth rate |
|---|---|---|---|
| 2021-06-29 | 65+ | 391708 | -0.17 |
| 2021-06-29 | 50-64 | 703990 | -0.13 |
| 2021-06-29 | 18-49 | 2127853 | -0.11 |
| 2021-06-29 | 0-17 | 484599 | -0.10 |
| 2021-04-23 | 65+ | 384595 | -0.01 |
| 2020-12-23 | 0-17 | 234174 | 0.00 |
[Text] Note: the red line of boxplot is median
Gender vs Total Cases
point <- format_format(big.mark = " ", decimal.mark = ",", scientific = FALSE)
grid.arrange(
gender %>%
ggplot(aes(x = gender, y = total_cases, fill = gender)) +
geom_bar(stat = "identity", width = 0.5) +
scale_fill_viridis(discrete = TRUE) +
theme(
legend.position = "none"
) +
xlab("Gender") +
ylab("Total cases") +
theme(legend.title = element_text(size = 5),
legend.key.size = unit(0.3, 'cm'),
legend.text = element_text(size = 4)) +
theme(
axis.title.x = element_text(size = 6),
axis.text.x = element_text(size = 5),
axis.title.y = element_text(size = 6),
axis.text.y = element_text(size = 5)) +
scale_y_continuous(labels = point),
gender %>%
ggplot(aes(x = total_cases, fill = gender)) +
geom_histogram(aes(y = ..density..), alpha = 0.5, bins = 30) +
geom_density(alpha = 0.3, aes(color = gender)) +
scale_color_viridis(discrete = TRUE) +
labs(x = "Total cases",
y = "Density") +
theme(legend.position = "right") +
theme(legend.title = element_text(size = 5),
legend.key.size = unit(0.3, 'cm'),
legend.text = element_text(size = 4)) +
theme(
axis.title.x = element_text(size = 6),
axis.text.x = element_text(size = 5),
axis.title.y = element_text(size = 6),
axis.text.y = element_text(size = 5)) +
scale_x_continuous(labels = point) +
scale_y_continuous(labels = point) +
scale_fill_viridis(discrete = TRUE),
gender %>%
ggplot(aes(x = gender, y = total_cases, fill = gender)) +
geom_boxplot(alpha = 0.5) +
geom_hline(yintercept = median(gender$total_cases, na.rm = T), color = "red", size = 0.4, lty = "dashed") +
scale_fill_viridis(discrete = TRUE) +
theme(
legend.position = "none"
) +
xlab("Gender") +
ylab("Total cases") +
theme(legend.title = element_text(size = 5),
legend.key.size = unit(0.3, 'cm'),
legend.text = element_text(size = 4)) +
theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
theme(
axis.title.x = element_text(size = 6),
axis.text.x = element_text(size = 5),
axis.title.y = element_text(size = 6),
axis.text.y = element_text(size = 5)) +
scale_y_continuous(labels = point),
layout_matrix = rbind(c(1, 1, 1, 2, 2, 2, 2),
c(1, 1, 1, 2, 2, 2, 2),
c(1, 1, 1, 2, 2, 2, 2),
c(3, 3, 3, 2, 2, 2, 2),
c(3, 3, 3, 2, 2, 2, 2)
))
gender_M =
gender %>%
filter(gender == "Male") %>%
arrange(date) %>%
mutate(lag = lag(total_cases)) %>%
mutate(growth_perc = (((total_cases - lag) / total_cases)) * 100)
gender_F =
gender %>%
filter(gender == "Female") %>%
arrange(date) %>%
mutate(lag = lag(total_cases)) %>%
mutate(growth_perc = (((total_cases - lag) / total_cases)) * 100)
gender_all =
rbind(gender_M, gender_F) %>%
arrange(desc(growth_perc)) %>%
select(date, gender, total_cases, growth_perc)
head(gender_all) %>%
knitr::kable(
caption = "Highest total cases growth rate by gender",
col.names = c("Date", "Gender", "Total cases", "Growth rate"),
digits = 2
)| Date | Gender | Total cases | Growth rate |
|---|---|---|---|
| 2020-04-29 | Male | 24372 | 5.44 |
| 2022-01-09 | Female | 3034425 | 5.31 |
| 2020-04-23 | Female | 19394 | 5.15 |
| 2020-04-24 | Female | 20395 | 4.91 |
| 2022-01-09 | Male | 2813232 | 4.89 |
| 2022-01-16 | Female | 3445681 | 4.80 |
gender_all_1 =
rbind(gender_M, gender_F) %>%
arrange(growth_perc) %>%
select(date, gender, total_cases, growth_perc)
head(gender_all_1) %>%
knitr::kable(
caption = "Lowest total cases growth rate by gender",
col.names = c("Date", "Gender", "Total cases", "Growth rate"),
digits = 2
)| Date | Gender | Total cases | Growth rate |
|---|---|---|---|
| 2021-06-29 | Male | 1774418 | -0.12 |
| 2021-06-29 | Female | 1884983 | -0.11 |
| 2020-12-23 | Male | 945758 | 0.00 |
| 2020-12-30 | Male | 1064781 | 0.00 |
| 2020-12-23 | Female | 993649 | 0.00 |
| 2020-12-30 | Female | 1121071 | 0.00 |
Race vs Total Cases
point <- format_format(big.mark = " ", decimal.mark = ",", scientific = FALSE)
grid.arrange(
race %>%
mutate(race_group = recode(race_group, "American Indian or Alaska Native" = "Indian/Alaska",
"Native Hawaiian and other Pacific Islander" = "Hawaiian/Islander")) %>%
mutate(race_group = fct_reorder(race_group, total_cases)) %>%
ggplot(aes(x = race_group, y = total_cases, fill = race_group)) +
geom_bar(stat = "identity", width = 0.5) +
scale_fill_viridis(discrete = TRUE) +
theme(
legend.position = "none"
) +
xlab("Race") +
ylab("Total cases") +
theme(legend.title = element_text(size = 5),
legend.key.size = unit(0.3, 'cm'),
legend.text = element_text(size = 4)) +
theme(
axis.title.x = element_text(size = 6),
axis.text.x = element_text(size = 5),
axis.title.y = element_text(size = 6),
axis.text.y = element_text(size = 5)) +
scale_y_continuous(labels = point) +
theme(axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank()),
race %>%
mutate(race_group = recode(race_group, "American Indian or Alaska Native" = "Indian/Alaska",
"Native Hawaiian and other Pacific Islander" = "Hawaiian/Islander")) %>%
mutate(race_group = fct_reorder(race_group, total_cases)) %>%
ggplot(aes(x = total_cases, fill = race_group)) +
geom_histogram(aes(y = ..density..), alpha = 0.5, bins = 30) +
geom_density(alpha = 0.1, aes(color = race_group)) +
scale_color_viridis(discrete = TRUE) +
labs(x = "Total cases",
y = "Density") +
theme(legend.position = "right") +
theme(legend.title = element_text(size = 5),
legend.key.size = unit(0.3, 'cm'),
legend.text = element_text(size = 4)) +
theme(
axis.title.x = element_text(size = 6),
axis.text.x = element_text(size = 5),
axis.title.y = element_text(size = 6),
axis.text.y = element_text(size = 5)) +
xlim(0, 2.5e6) +
ylim(0, 1.5e-5),
race %>%
mutate(race_group = fct_reorder(race_group, total_cases)) %>%
mutate(race_group = recode(race_group, "American Indian or Alaska Native" = "Indian/Alaska",
"Native Hawaiian and other Pacific Islander" = "Hawaiian/Islander")) %>%
ggplot(aes(x = race_group, y = total_cases, fill = race_group)) +
geom_boxplot(alpha = 0.5) +
geom_hline(yintercept = median(race$total_cases, na.rm = T), color = "red", size = 0.4, lty = "dashed") +
ylim(0, 30000) +
scale_fill_viridis(discrete = TRUE) +
theme(
legend.position = "none"
) +
xlab("Race") +
ylab("Total cases") +
theme(legend.title = element_text(size = 5),
legend.key.size = unit(0.3, 'cm'),
legend.text = element_text(size = 4)) +
theme(
axis.title.x = element_text(size = 6),
axis.text.x = element_text(size = 5),
axis.title.y = element_text(size = 6),
axis.text.y = element_text(size = 5)) +
scale_y_continuous(labels = point) +
theme(axis.text.x = element_text(angle = 60, hjust = 1)),
layout_matrix = rbind(c(1, 1, 1, 2, 2, 2, 2),
c(1, 1, 1, 2, 2, 2, 2),
c(1, 1, 1, 2, 2, 2, 2),
c(3, 3, 3, 2, 2, 2, 2),
c(3, 3, 3, 2, 2, 2, 2)
))
(table for race and demo have not finished yet)
[Text]
Death Rate
Age vs Death Rate
age %>%
mutate(date = factor(date)) %>%
mutate(text_label = str_c("Date: ", date,
"\n Age: ", age_group,
"\n Death(%): ", percent_deaths)) %>%
plot_ly(y = ~percent_deaths,
x = ~date,
color = ~age_group,
width = 950,
height = 300,
type = "scatter",
mode = "markers",
marker = list(size = 3),
colors = "inferno",
text = ~ text_label) %>%
layout(xaxis = list(
title = "Date",
tickangle = 60),
yaxis = list(
title = "Death Rate"))[Text]
Gender vs Death Rate
gender %>%
mutate(date = factor(date)) %>%
mutate(text_label = str_c("Date: ", date,
"\n Gender: ", gender,
"\n Death(%): ", percent_deaths)) %>%
plot_ly(y = ~percent_deaths,
x = ~date,
color = ~gender,
width = 950,
height = 300,
type = "scatter",
mode = "markers",
marker = list(size = 3),
colors = "viridis",
text = ~ text_label) %>%
layout(xaxis = list(
title = "Date",
tickangle = 60),
yaxis = list(
title = "Death Rate"))[Text]
Race vs Death Rate
race %>%
mutate(date = factor(date)) %>%
mutate(race_group = recode(race_group, "American Indian or Alaska Native" = "Indian/Alaska",
"Native Hawaiian and other Pacific Islander" = "Hawaiian/Islander")) %>%
mutate(text_label = str_c("Date: ", date,
"\n Race: ", race_group,
"\n Death(%): ", percent_deaths)) %>%
plot_ly(y = ~percent_deaths,
x = ~date,
color = ~race_group,
width = 950,
height = 300,
type = "scatter",
mode = "markers",
marker = list(size = 3),
colors = "inferno",
text = ~ text_label) %>%
layout(xaxis = list(
title = "Date",
tickangle = 60),
yaxis = list(
title = "Death Rate"))[Text]
Area vs Death Rate
demo %>%
mutate(percent_deaths = (cumulative_deaths / cumulative_cases) * 100) %>%
mutate(date = factor(date)) %>%
mutate(text_label = str_c("Date: ", date,
"\n Area: ", county_name,
"\n Death(%): ", percent_deaths)) %>%
plot_ly(y = ~percent_deaths,
x = ~date,
color = ~county_name ,
width = 950,
height = 500,
type = "scatter",
mode = "markers",
marker = list(size = 3),
colors = "inferno",
text = ~ text_label) %>%
layout(xaxis = list(
title = "Date",
tickangle = 60),
yaxis = list(
title = "Death Rate",
range = c(0, 13)))[Text: Note: states users can use our dashboard to research this]
[Text]